﻿<%@  language="vbscript" codepage="65001" %>
<!--#include FILE="inc/CreateThumb.asp"-->
<!--#include FILE="inc/cf.asp"-->
<!--#include FILE="inc/function.asp"-->
<% 
if isnull(Session("upload")) or Session("upload")<>"open" then 
    Response.Write "1&upload is not open"
    Response.End()
end if
%>
<% 
if IsRemotePost2() then
    Response.Write "2&禁止远程提交数据"  
    Response.End      
end if


' 注意不能用Request.Form,否则出错
' ----------------------------------------
if getquerystring("u","")<>"u" then
    Response.Write "2&非法提交数据,缺少参数!!"        
else    
    dim upfile    
    set upfile=new upfile_class ''建立上传对象   
    'upfile.IsDebug=true   ' 上传调试模式
    upfile.NoAllowExt="asp;exe;htm;html;aspx;cs;vb;js;asa"	'设置上传类型的黑名单
    upfile.GetData (10240000)   '取得上传数据,限制最大上传10M
    'FSPath=getquerystring("uppath","f/")
    FSPath=conUpFilePath
    isThumb=getquerystring("isthumb","false")  ' 是否生成缩略图
    
    if upfile.isErr > 0 then  '如果出错
        Response.Write "2&上传文件遇到可预见错误,代码为" & upfile.iserr & "!"
	    Response.End()
    else		
	    set oFile=upfile.file("file")
	    oFileSize=oFile.filesize
		
	    ' 检测是否为空
	    '//////////////////////////////////////////
	    if ofile.FileName="" then
	        Response.Write "2&请先选择你要上传的文件！"
	        Response.End()
	    end if
	    
	    ' 检测文件夹是否存在
		'//////////////////////////////////////////
		set fso=server.CreateObject("Scripting.FileSystemObject")
		if fso.FolderExists(Server.mappath(FSPath)) then
		    EnabledUpload=true
		end if
		set fso=nothing 
		if not EnabledUpload then
		    Response.Write "2&文件夹("&FSPath&")不存在！"
		    Response.End()
		end if
	    
	    
		
	    ' 限制文件类型
	    '//////////////////////////////////////////
	    dim AllowExt,EnabledUpload
	    EnabledUpload=false
	    AllowExt="jpg|gif|png|bmp|flv|swf|rar|zip|doc"
	    if cStr(conAllowFileType)<>"" then
	        AllowExt=lcase(conAllowFileType)
	    end if
	    for each fe in  Split(AllowExt,"|")
	        if lcase(fe)=lcase(oFile.FileExt) then
	            EnabledUpload=true
	            Exit For
	        end if
	    next
	    if not EnabledUpload then
	        Response.Write "2&该文件类型禁止上传！只允许:" & AllowExt
	        Response.End()
	    end if
		
	    ' 限制大小
	    '//////////////////////////////////////////
	    dim MaxSize
	    MaxSize=50
	    if cStr(conMaxFileSize)<>"" then
	        MaxSize=conMaxFileSize
	    end if
	    if oFileSize>MaxSize*1024 then
	        Response.Write "2&你上传的文件超出我们的限制！最大" & MaxSize & "KB'"
	        Response.End()
	    end if	
		
		
	    ' 文件名
	    '//////////////////////////////////////////
		if conUpFileNameMode=0 then ' f/XXXXXXXXXX.jpg
			tempName=upfile.GetNewFileName() ' 根据时间 重命名文件名,		
			FileName=tempName & "." & oFile.FileExt
		else                     ' path/09_12_01/pic.jpg
			FileName=NewPathByDate & oFile.filename ' 日期做文件夹/原文件名,
		end if
		
		dim fullname
	    fullname=Server.mappath(FSPath&FileName)
		
		' 判断是否存在相同文件名
		'////////////////////////////////////////
		if IsFileExists(fullname) then
			Response.Write "2&上传文件失败！目录中存在相同文件名"
			Response.end()
		end if
		
		' 保存文件
		'////////////////////////////////////////
	    upfile.SaveToFile "file",fullname
		
	    if isThumb="true" and conOpenCreateThumb=1 then		    
	        ' 生成缩略图
	        '////////////////////////////////////////		
	        set thumb=new CreateThumb 		    
            thumb.Thumb_Arithmetic=2 '常规算法：宽度和高度都大于0时，直接缩小成指定大小，其中一个为0时，按比例缩小
            thumb.Thumb_Width=conThumbWidth  '  宽度
            thumb.Thumb_Height=0
	        ' 常规变量            
	        thumb.CreateThumb FSPath & FileName,"s_" & FSPath & FileName,0,0		
	    end if
		
		
	    if err.number=0 then
			if IsFileExists(fullname) then '验证文件是否存在
				Response.Write "0&"&FSPath & FileName
			else
				Response.Write "2&上传文件失败！目录权限或空间不足,检查相关设置"
			end if			       
		    Set oFile = Nothing
	        Set upfile=Nothing
	    else
	        Response.Write "2&未知错误,上传文件失败！"
	    end if		
    end if    
end if 


'判断是否远程数据提交
'**************************************
function IsRemotePost2()
    dim refhost,hhost
    hhost=lcase(Trim(Request.ServerVariables("HTTP_HOST")))
    refhost=replace(lcase(Trim(Request.ServerVariables("HTTP_REFERER"))),"http://","")
    if refhost<>"" then
        if hhost<>mid(refhost,1,InStr(refhost,"/")-1) then
            IsRemotePost2=true
        else
            IsRemotePost2=false
        end if
    else
        IsRemotePost2=false
    end if   
end function

function NewPathByDate()
	dim yy,mm,dd
	yy=right(year(date),2)
    mm=right("00"&month(date),2)
    dd=right("00"&day(date),2)
    NewPathByDate=yy & "_" & mm & "_" & dd & "/"
end function
%>

<%
'----------------------------------------------------------------------
'----------------------------------------------------------------------
'----------------------------------------------------------------------
'文件上传类
Class UpFile_Class

    Dim Form,File
    Dim AllowExt_	'允许上传类型(白名单)
    Dim NoAllowExt_	'不允许上传类型(黑名单)
    Dim IsDebug_ '是否显示出错信息
    Private	oUpFileStream	'上传的数据流
    Private isErr_		'错误的代码,0或true表示无错
    Private ErrMessage_	'错误的字符串信息
    Private isGetData_	'指示是否已执行过GETDATA过程
    Private CharSet_   '字符集,设置gb2312,,utf-8

    '------------------------------------------------------------------
    '类的属性
    Public Property Get Version
	    Version="无惧上传类 Version V2.0"
    End Property

    Public Property Get isErr		'错误的代码,0或true表示无错
	    isErr=isErr_
    End Property

    Public Property Get ErrMessage		'错误的字符串信息
	    ErrMessage=ErrMessage_
    End Property

    Public Property Get AllowExt		'允许上传类型(白名单)
	    AllowExt=AllowExt_
    End Property

    Public Property Let AllowExt(Value)	'允许上传类型(白名单)
	    AllowExt_=LCase(Value)
    End Property

    Public Property Get NoAllowExt		'不允许上传类型(黑名单)
	    NoAllowExt=NoAllowExt_
    End Property

    Public Property Let NoAllowExt(Value)	'不允许上传类型(黑名单)
	    NoAllowExt_=LCase(Value)
    End Property

    Public Property Let IsDebug(Value)	'是否设置为调试模式
	    IsDebug_=Value
    End Property


    '----------------------------------------------------------------
    '类实现代码

    '初始化类
    Private Sub Class_Initialize
	    isErr_ = 0
	    NoAllowExt="asp;aspx;php;exe;asa"		'黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用;号分开,如果黑名单为空,则判断白名单
	    NoAllowExt=LCase(NoAllowExt)
	    AllowExt=""		'白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用;号分开
	    AllowExt=LCase(AllowExt)
	    CharSet_="utf-8"
	    isGetData_=false
    	
    End Sub

    '类结束
    Private Sub Class_Terminate	
	    on error Resume Next
	    '清除变量及对像
	    Form.RemoveAll
	    Set Form = Nothing
	    File.RemoveAll
	    Set File = Nothing
	    oUpFileStream.Close
	    Set oUpFileStream = Nothing
	    if Err.number<>0 then OutErr("清除类时发生错误!")
    End Sub

    '分析上传的数据
    Public Sub GetData (MaxSize)
	     '定义变量
	    on error Resume Next
	    if isGetData_=false then 
		    Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
		    Dim sFormValue,sFileName
		    Dim iFindStart,iFindEnd
		    Dim iFormStart,iFormEnd,sFormName
		    '代码开始
		    If Request.TotalBytes < 1 Then	'如果没有数据上传
			    isErr_ = 1
			    ErrMessage_="没有数据上传,这是因为直接提交网址所产生的错误!"
			    OutErr("没有数据上传,这是因为直接提交网址所产生的错误!!")
			    Exit Sub
		    End If
		    If MaxSize > 0 Then '如果限制大小
			    If Request.TotalBytes > MaxSize Then
			    isErr_ = 2	'如果上传的数据超出限制大小
			    ErrMessage_="上传的数据超出限制大小!"
			    OutErr("上传的数据超出限制大小!")
			    Exit Sub
			    End If
		    End If
		    Set Form = Server.CreateObject ("Scripting.Dictionary")
		    Form.CompareMode = 1
		    Set File = Server.CreateObject ("Scripting.Dictionary")
		    File.CompareMode = 1
		    Set tStream = Server.CreateObject ("ADODB.Stream")
		    Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
		    if Err.number<>0 then OutErr("创建流对象(ADODB.STREAM)时出错,可能系统不支持或没有开通该组件")
		    oUpFileStream.Type = 1
		    oUpFileStream.Mode = 3
		    oUpFileStream.Open 
		    oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
		    oUpFileStream.Position = 0
		    RequestBinDate = oUpFileStream.Read 
		    iFormEnd = oUpFileStream.Size
		    bCrLf = ChrB (13) & ChrB (10)
		    '取得每个项目之间的分隔符
		    sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
		    iStart = LenB(sSpace)
		    iFormStart = iStart+2
		    '分解项目
		    Do
			    iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
			    tStream.Type = 1
			    tStream.Mode = 3
			    tStream.Open
			    oUpFileStream.Position = iFormStart
			    oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
			    tStream.Position = 0
			    tStream.Type = 2
			    tStream.CharSet = CharSet_
			    sInfo = tStream.ReadText			
			    '取得表单项目名称
			    iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
			    iFindStart = InStr (22,sInfo,"name=""",1)+6
			    iFindEnd = InStr (iFindStart,sInfo,"""",1)
			    sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
			    '如果是文件
			    If InStr (45,sInfo,"filename=""",1) > 0 Then
				    Set oFileInfo = new FileInfo_Class
				    '取得文件属性
				    iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
				    iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
				    sFileName = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
				    oFileInfo.FileName = GetFileName(sFileName)
				    oFileInfo.FilePath = GetFilePath(sFileName)
				    oFileInfo.FileExt = GetFileExt(sFileName)
				    iFindStart = InStr (iFindEnd,sInfo,"content-type: ",1)+14
				    iFindEnd = InStr (iFindStart,sInfo,vbCr)
				    oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
				    oFileInfo.FileStart = iInfoEnd
				    oFileInfo.FileSize = iFormStart -iInfoEnd -2
				    oFileInfo.FormName = sFormName
				    file.add sFormName,oFileInfo
			    else
			    '如果是表单项目
				    tStream.Close
				    tStream.Type = 1
				    tStream.Mode = 3
				    tStream.Open
				    oUpFileStream.Position = iInfoEnd 
				    oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
				    tStream.Position = 0
				    tStream.Type = 2
				    tStream.CharSet = CharSet_
				    sFormValue = tStream.ReadText
				    If Form.Exists (sFormName) Then
					    Form (sFormName) = Form (sFormName) & ", " & sFormValue
					    else
					    Form.Add sFormName,sFormValue
				    End If
			    End If
			    tStream.Close
			    iFormStart = iFormStart+iStart+2
			    '如果到文件尾了就退出
		    Loop Until (iFormStart+2) >= iFormEnd 
		    if Err.number<>0 then OutErr("分解上传数据时发生错误,可能客户端的上传数据不正确或不符合上传数据规则")
		    RequestBinDate = ""
		    Set tStream = Nothing
		    isGetData_=true
	    end if
    End Sub

    '保存到文件,自动覆盖已存在的同名文件
    Public Function SaveToFile(Item,Path)
	    SaveToFile=SaveToFileEx(Item,Path,True)
    End Function

    '保存到文件,自动设置文件名
    Public Function AutoSave(Item,Path)
	    AutoSave=SaveToFileEx(Item,Path,false)
    End Function

    '保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
    Private Function SaveToFileEx(Item,Path,Over)
	    On Error Resume Next
	    Dim FileExt
	    if file.Exists(Item) then
		    Dim oFileStream
		    Dim tmpPath
		    isErr_=0
		    Set oFileStream = CreateObject ("ADODB.Stream")
		    oFileStream.Type = 1
		    oFileStream.Mode = 3
		    oFileStream.Open
		    oUpFileStream.Position = File(Item).FileStart
		    oUpFileStream.CopyTo oFileStream,File(Item).FileSize
		    tmpPath= mid(path,1,InStrRev(path,".")-1)
		    FileExt=GetFileExt(Path)
		    if Over then
			    if isAllowExt(FileExt) then
					CreateFilePath(GetFilePath(Path))
					
				    oFileStream.SaveToFile tmpPath & "." & FileExt,2
				    if Err.number<>0 then OutErr("保存文件时出错,请检查路径,是否存在该上传目录!该文件保存路径为" & tmpPath & "." & FileExt)
				Else
				    isErr_=3
				    ErrMessage_="该后缀名的文件不允许上传!"
				    OutErr("该后缀名的文件不允许上传")
			    End if
			Else
				Path=GetFilePath(Path)
				dim fori
				fori=1
			    if isAllowExt(File(Item).FileExt) then
				    do
					    fori=fori+1
					    Err.Clear()
					    tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
					    oFileStream.SaveToFile tmpPath
				    loop Until ((Err.number=0) or (fori>50))
				    if Err.number<>0 then OutErr("自动保存文件出错,已经测试50次不同的文件名来保存,请检查目录是否存在!该文件最后一次保存时全路径为"&Path&GetNewFileName()&"."&File(Item).FileExt)
				Else
				    isErr_=3
				    ErrMessage_="该后缀名的文件不允许上传!"
				    OutErr("该后缀名的文件不允许上传")
			    End if
		    End if
		    oFileStream.Close
		    Set oFileStream = Nothing
	    else
		    ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
		    OutErr("不存在该对象(如该文件没有上传,文件为空)")
	    end if
	    if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
    End Function

    '取得文件数据
    Public Function FileData(Item)
	    isErr_=0
	    if file.Exists(Item) then
		    if isAllowExt(File(Item).FileExt) then
			    oUpFileStream.Position = File(Item).FileStart
			    FileData = oUpFileStream.Read (File(Item).FileSize)
			Else
			    isErr_=3
			    ErrMessage_="该后缀名的文件不允许上传"
			    OutErr("该后缀名的文件不允许上传")
			    FileData=""
		    End if
	    else
		    ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
		    OutErr("不存在该对象(如该文件没有上传,文件为空)")
	    end if
    End Function

	' 创建文件夹
	Private function CreateFilePath(fullpath)
		dim fso
		set fso=server.CreateObject("Scripting.FileSystemObject")
		if not fso.FolderExists(fullpath) then
			fso.CreateFolder(fullpath)
		end if
		set fso=nothing
	end function

    '取得文件路径
    Public function GetFilePath(FullPath)
		If FullPath <> "" Then
			GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
		Else
			GetFilePath = ""
		End If
    End function

    '取得文件名
    Public Function GetFileName(FullPath)
		If FullPath <> "" Then
			GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
		Else
			GetFileName = ""
		End If
    End function

    '取得文件的后缀名
	Public Function GetFileExt(FullPath)
		If FullPath <> "" Then
			GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
		Else
			GetFileExt = ""
		End If
	End function	
	

    '取得一个不重复的序号
    Public Function GetNewFileName()
	    dim ranNum
	    dim dtNow
	    dtNow=Now()
	    randomize
	    ranNum=int(90000*rnd)+10000
	    '以下这段由webboy提供
	    GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
    End Function

    Public Function isAllowExt(Ext)
	    if NoAllowExt="" then
		    isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
		else
		    isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
	    end if
    End Function
End Class

Public Sub OutErr(ErrMsg)
if IsDebug_=true then
	Response.Write ErrMsg
	Response.End
	End if
End Sub

'----------------------------------------------------------------------------------------------------
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class

%>